home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / c / amivogl-1.03.lzh / vogl / examples / fworld.for < prev    next >
Encoding:
Text File  |  1991-06-04  |  2.7 KB  |  166 lines
  1. c
  2. c most of the things in this program have been done before but it has
  3. c a certain novelty value.
  4. c
  5.     program fworld
  6.  
  7. $INCLUDE: 'fvogl.h'
  8. $INCLUDE: 'fvodevic.h'
  9.  
  10.     integer *2 val
  11.     integer SPHERE
  12.     real RADIUS, PI
  13.     parameter (RADIUS = 10.0, PI = 3.1415926535, SPHERE = 1)
  14.  
  15.     call winope('fworld', 6)
  16.     call hfont('futura.m', 8)
  17.  
  18.     call unqdev(INPUTC)
  19.     call qdevic(SPACEK)
  20.     call qdevic(QKEY)
  21.     call qdevic(ESCKEY)
  22.  
  23.     call perspe(800, 1.0, 0.001, 50.0)
  24.     call lookat(13.0, 13.0, 8.0, 0.0, 0.0, 0.0, 0)
  25.  
  26.     call color(BLACK)
  27.     call clear
  28.  
  29.     call makesp
  30.  
  31. c
  32. c     draw the main one in cyan
  33. c
  34.     call color(CYAN)
  35.  
  36.     call callob(SPHERE)
  37.  
  38. c
  39. c    draw a smaller one outside the main one in white
  40. c
  41.     call color(WHITE)
  42.  
  43.     call pushma
  44.         call transl(0.0, -1.4 * RADIUS, 1.4 * RADIUS)
  45.         call scale(0.3, 0.3, 0.3)
  46.         call callob(SPHERE)
  47.     call popmat
  48.  
  49. c
  50. c    scale the text
  51. c
  52.     call hboxfi(2.0 * PI * RADIUS, 0.25 * RADIUS, 31)
  53.  
  54. c
  55. c    now write the text in rings around the main sphere
  56. c
  57.  
  58.     call color(GREEN)
  59.     call showroundtext('Around the world in eighty days ')
  60.  
  61.     call color(BLUE)
  62. c
  63. c    note: that software text is rotated here as
  64. c    anything else would be whether you use textang
  65. c    or rotate depends on what you are trying to do.
  66. c    Experience is the best teacher here.
  67. c
  68.     call rotate(900, 'x')
  69.     call showroundtext('Around the world in eighty days ')
  70.  
  71.     call color(RED)
  72.     call rotate(900, 'z')
  73.     call showroundtext('Around the world in eighty days ')
  74.  
  75.     idum = qread(val)
  76.  
  77.     call gexit
  78.  
  79.     end
  80. c
  81. c showroundtext
  82. c
  83. c    draw string str wrapped around a circ in 3d
  84. c
  85.     subroutine showroundtext(str)
  86.     character *(*) str
  87.  
  88.     real RADIUS
  89.     parameter (RADIUS = 10.0)
  90.     integer j
  91.  
  92.     inc = 3600 / float(nchars(str))
  93.  
  94.     j = 1
  95.     do 10 i = 0, 3600, inc
  96.         call pushma
  97. c
  98. c             find the spot on the edge of the sphere
  99. c             by making it (0, 0, 0) in world coordinates
  100. c
  101.             call rotate(i, 'y')
  102.             call transl(0.0, 0.0, RADIUS)
  103.  
  104.             call move(0.0, 0.0, 0.0)
  105.  
  106.             call hdrawc(str(j:j))
  107.             j = j + 1
  108.         call popmat
  109. 10    continue
  110.  
  111.     end
  112.  
  113. c
  114. c makesphere
  115. c
  116. c    create the sphere object
  117. c
  118.     subroutine makesp
  119.     integer SPHERE
  120.     parameter (SPHERE = 1)
  121.     parameter(PI = 3.1415926535)
  122.     parameter(RADIUS = 10.0)
  123.  
  124.     call makeob(SPHERE)
  125.  
  126.     do 10 i = 0, 1800, 200
  127.         call pushma
  128.             call rotate(i, 'y')
  129.             call circ(0.0, 0.0, RADIUS)
  130.         call popmat
  131. 10    continue
  132.     
  133.     call pushma
  134.         call rotate(900, 'x')
  135.         do 20 a = -90.0, 90.0, 20.0
  136.             r = RADIUS * cos(a*PI/180.0)
  137.             z = RADIUS * sin(a*PI/180.0)
  138.             call pushma
  139.                 call transl(0.0, 0.0, -z)
  140.                 call circ(0.0, 0.0, r)
  141.             call popmat    
  142. 20        continue
  143.     call popmat
  144.  
  145.     call closeo
  146.  
  147.     return
  148.     end
  149. c
  150. c nchars
  151. c
  152. c    find the number of characters in the string str
  153. c
  154.     integer function nchars(str)
  155.     character *(*) str
  156.     
  157.     do 10 i = len(str), 1, -1
  158.         if (str(i:i) .ne. ' ') then
  159.             nchars = i
  160.             return
  161.         end if
  162. 10    continue
  163.     nchars = 0
  164.     return
  165.     end
  166.